home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0787.arc / IWPAS.ARC / SHOWEGA3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-12  |  3.1 KB  |  119 lines
  1.  
  2. PROGRAM ShowEGA(input,output,picfile);
  3.  
  4. { Copyright (c) 1987, Ciarcia's Circuit Cellar          }
  5. {    All Rights Reserved                                }
  6.  
  7. { Version 1.01                  May 12, 1987            }
  8. {   Fixed SendEGA so it would work with more types      }
  9. {    of EGA boards.  kwd                                }
  10.  
  11. { shows image on EGA using direct color mappings        }
  12.  
  13. {$U- control-break checking during execution            }
  14. {$C- control-break checking during I/O operations       }
  15. {$R- array range checking                               }
  16.  
  17. {$Ideclares.p                   declarations            }
  18. {$Ihexutil.p                    hex utilities           }
  19. {$Iserial.p                     serial interface code   }
  20. {$Ipictures.p                   picture file code       }
  21. {$Iimages.p                     image processing        }
  22.  
  23. CONST
  24.  EGAint   = $10;                { EGA video services    }
  25.  graymax  = 9;                  { # gray shades - 1     }
  26.  
  27. TYPE
  28.  crng     = 0..graymax;         { gray scale index      }
  29.  cmaptype = ARRAY[bitrng] OF crng;
  30.  
  31. VAR
  32.  r        : regrec;
  33.  cmap     : cmaptype;
  34.  
  35. {--- Assign EGA colors based on binary truncations      }
  36.  
  37. PROCEDURE ShadeEGA(pic1 : picptr;
  38.                VAR cmap  : cmaptype);
  39.  
  40. VAR
  41.  bin        : bitrng;           { index into bins       }
  42.  binsum     : REAL;             { accumulated # pels    }
  43.  binthresh  : REAL;
  44.  cnum       : crng;             { color numbers         }
  45.  histo      : histtype;         { intensity histogram   }
  46.  
  47. BEGIN
  48.  
  49.  Writeln('Assigning colors');
  50.  
  51.  FOR bin := 0 TO maxbit DO
  52.   cmap[bin] := bin DIV 4;
  53.  
  54. END;
  55.  
  56.  
  57. {--- Show picture on EGA                                }
  58.  
  59. PROCEDURE SendEGA(pic  : picptr;
  60.                   cmap : cmaptype);
  61.  
  62. VAR
  63.  r         : regrec;            { BIOS interface regs   }
  64.  row,col   : INTEGER;           { EGA coordinates       }
  65.  lndx      : linerng;           { line number           }
  66.  pndx      : pelrng;            { pel number            }
  67.  pelval1   : INTEGER;           { pel value left        }
  68.  pelval2   : INTEGER;           { pel value right       }
  69.  
  70. BEGIN
  71.  
  72.  r.AX := ($00 SHL 8) OR $10;    { 640 x 350 / 16 colors }
  73.  Intr(EGAint,r);
  74.  
  75.  row := 50;
  76.  FOR lndx := 0 TO maxline DO BEGIN
  77.   col := 64;
  78.   FOR pndx := 0 TO maxpel DO BEGIN
  79.    pelval1 := cmap[pic^.fmt.lines[lndx].pels[pndx]];
  80.    r.AH := $0C;
  81.    r.AL := pelval1;
  82.    r.BX := $0000;
  83.    r.CX := col;
  84.    r.DX := row;
  85.    Intr(EGAint,r);
  86.    col := Succ(col);
  87.   END;
  88.   row := Succ(row);
  89.   IF KeyPressed
  90.    THEN BEGIN
  91.     TextMode;
  92.     HALT;
  93.    END;
  94.  END;
  95.  
  96. END;
  97.  
  98. {--- Main routine                                       }
  99.  
  100. BEGIN
  101.  
  102.  pic1 := NIL;                   { ensure new alloc      }
  103.  PicSetup(pic1);                { set up picture array  }
  104.  
  105.  filespec := GetFSpec(ParamStr(1));
  106.  
  107.  LoadPicture(filespec,pic1);    { read picture          }
  108.  
  109.  ShadeEGA(pic1,cmap);           { determine color map   }
  110.  
  111.  SendEGA(pic1,cmap);            { send mapped picture   }
  112.  
  113.  GoToXY(1,24);
  114.  Write('Press Enter');
  115.  Readln;
  116.  TextMode;
  117.  
  118. END.
  119.